home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbactlm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-20  |  22.1 KB  |  597 lines
  1. (*===========================================================================*)
  2. (* Load action file                                                          *)
  3. (*                                                                           *)
  4. (*   Copyright 1990, 1991, 1992 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8.   (*=========================================================================*)
  9.   (* Main line                                                               *)
  10.   (*=========================================================================*)
  11.  
  12.   BEGIN;
  13.  
  14.     {$IFDEF DEBUG1}
  15.       WRITELN('Action load start');
  16.       DELAY(1000);
  17.     {$ENDIF}
  18.  
  19.     (*-----------------------------------------------------------------------*)
  20.     (* Get right options                                                     *)
  21.     (*-----------------------------------------------------------------------*)
  22.  
  23.     execute_load  := POS(execute_who, 'LF ' + #1) > 0;
  24.     execute_make  := POS(execute_who, 'MF ') > 0;
  25.     execute_clean := POS(execute_who, 'C ')  > 0;
  26.  
  27.     (*-----------------------------------------------------------------------*)
  28.     (* See if we can run.                                                    *)
  29.     (*-----------------------------------------------------------------------*)
  30.  
  31.     IF execute_load AND bbs_busy AND (execute_who <> #1) THEN
  32.       BEGIN;
  33.         cannot_do_this(message_other_active);
  34.         EXIT;
  35.       END;
  36.  
  37.     {$IFDEF DEBUG1}
  38.       WRITELN('Action load ready');
  39.       DELAY(1000);
  40.     {$ENDIF}
  41.  
  42.     (*-----------------------------------------------------------------------*)
  43.     (* Lock the action area                                                  *)
  44.     (*-----------------------------------------------------------------------*)
  45.  
  46.     (*-----------------------------------------------------------------------*)
  47.     (* Tell user started                                                     *)
  48.     (*-----------------------------------------------------------------------*)
  49.  
  50.     send_tnc_data_str('Action processing is started -- Please wait.' + cr);
  51.  
  52.     (*-----------------------------------------------------------------------*)
  53.     (* Obtain the interrupt lock                                             *)
  54.     (*-----------------------------------------------------------------------*)
  55.  
  56.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  57.  
  58.     (*-----------------------------------------------------------------------*)
  59.     (* Free old action data                                                  *)
  60.     (*-----------------------------------------------------------------------*)
  61.  
  62.     IF execute_load THEN
  63.       free_action;
  64.  
  65.     (*-----------------------------------------------------------------------*)
  66.     (* Free the lock                                                         *)
  67.     (*-----------------------------------------------------------------------*)
  68.  
  69.     free_semaphore(semaphore_interrupts);
  70.  
  71.     (*-----------------------------------------------------------------------*)
  72.     (* Open action file for read                                             *)
  73.     (*-----------------------------------------------------------------------*)
  74.  
  75.     {$IFDEF DEBUG1}
  76.       WRITELN('Action load name check');
  77.       DELAY(1000);
  78.     {$ENDIF}
  79.  
  80.     IF opt_block.action_fn = '' THEN
  81.       EXIT;
  82.  
  83.     (*-----------------------------------------------------------------------*)
  84.     (* Obtain the interrupt lock                                             *)
  85.     (*-----------------------------------------------------------------------*)
  86.  
  87.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  88.  
  89.     (*-----------------------------------------------------------------------*)
  90.     (* Open action file for read                                             *)
  91.     (*-----------------------------------------------------------------------*)
  92.  
  93.     {$IFDEF DEBUG1}
  94.       WRITELN('Action load assign');
  95.       DELAY(1000);
  96.     {$ENDIF}
  97.  
  98.     ASSIGN(action_file, opt_block.action_fn);
  99.     {$I-}
  100.     RESET(action_file);
  101.     {$I+}
  102.     i := IORESULT;
  103.  
  104.     (*-----------------------------------------------------------------------*)
  105.     (* Free the lock                                                         *)
  106.     (*-----------------------------------------------------------------------*)
  107.  
  108.     free_semaphore(semaphore_interrupts);
  109.  
  110.     (*-----------------------------------------------------------------------*)
  111.     (* File doesn't exist.  Ooopss                                           *)
  112.     (*-----------------------------------------------------------------------*)
  113.  
  114.     IF i = 2 THEN
  115.       BEGIN;
  116.         send_tnc_data_str('Can''t find file -- ' +  opt_block.action_fn + cr);
  117.         active_tcb^.error_sw := TRUE;
  118.         EXIT;
  119.       END;
  120.  
  121.     IF i <> 0 THEN
  122.       BEGIN;
  123.         send_tnc_data_str('Error opening ' + opt_block.action_fn + cr);
  124.         STR(i, s1);
  125.         send_tnc_data_str('DOS error ' + s1 + cr);
  126.         active_tcb^.error_sw := TRUE;
  127.         EXIT;
  128.       END;
  129.  
  130.     (*-----------------------------------------------------------------------*)
  131.     (* Initialize things                                                     *)
  132.     (*-----------------------------------------------------------------------*)
  133.  
  134.     last_msg_action := NIL;
  135.  
  136.     (*-----------------------------------------------------------------------*)
  137.     (* Read thru file                                                        *)
  138.     (*-----------------------------------------------------------------------*)
  139.  
  140.     {$IFDEF DEBUG1}
  141.       WRITELN('Action load read loop');
  142.       DELAY(1000);
  143.     {$ENDIF}
  144.  
  145.     WHILE NOT EOF(action_file) DO
  146.       BEGIN;
  147.  
  148.         active_tcb^.error_sw := FALSE;
  149.  
  150.         READLN(action_file, s1);
  151.  
  152.         strip_var(s1, 'B');
  153.  
  154.         (*-------------------------------------------------------------------*)
  155.         (* Get the action word                                               *)
  156.         (*-------------------------------------------------------------------*)
  157.  
  158.         action_word := subword(@s1, 1, 1);
  159.  
  160.         upcase_str_var(action_word);
  161.  
  162.         {$IFDEF DEBUG2}
  163.           WRITELN('Action word -- ', action_word);
  164.           DELAY(1000);
  165.         {$ENDIF}
  166.  
  167.         (*-------------------------------------------------------------------*)
  168.         (* Ignore comments                                                   *)
  169.         (*-------------------------------------------------------------------*)
  170.  
  171.         IF (LENGTH(action_word) = 0)
  172.                              OR (action_word[1] = '*')
  173.                              OR (action_word[1] = ';') THEN
  174.           GOTO iterate;
  175.  
  176.         (*-------------------------------------------------------------------*)
  177.         (* Process "NO"                                                      *)
  178.         (*-------------------------------------------------------------------*)
  179.  
  180.         IF COPY(action_word, 1, 2) = 'NO' THEN
  181.           BEGIN;
  182.             action_word := COPY(action_word, 3, 255);
  183.             invert_flag := TRUE;
  184.           END
  185.         ELSE
  186.           invert_flag := FALSE;
  187.  
  188.         (*-------------------------------------------------------------------*)
  189.         (* DENY                                                              *)
  190.         (*-------------------------------------------------------------------*)
  191.  
  192.         IF action_word = 'DENY_NEW_MSG' THEN
  193.           BEGIN;
  194.  
  195.             IF NOT execute_load THEN
  196.               GOTO iterate;
  197.  
  198.             IF invert_flag THEN
  199.               build_format0_block
  200.             ELSE
  201.               build_format2_block(0, 9);
  202.  
  203.             new_msg_action^.action_type := action_msg_deny
  204.                                                OR new_msg_action^.action_type;
  205.             GOTO iterate;
  206.  
  207.           END;
  208.  
  209.         (*-------------------------------------------------------------------*)
  210.         (* HOLD/REJECT/REVIEW                                                *)
  211.         (*-------------------------------------------------------------------*)
  212.  
  213.         IF (action_word = 'HOLD')
  214.                       OR (action_word = 'HOLD_OLD')
  215.                       OR (action_word = 'REJECT')
  216.                       OR (action_word = 'REVIEW') THEN
  217.           BEGIN;
  218.  
  219.             IF NOT execute_load THEN
  220.               GOTO iterate;
  221.  
  222.             build_format0_block;
  223.  
  224.             IF action_word = 'REVIEW' THEN
  225.               BEGIN;
  226.                 new_msg_action^.action_type := action_msg_review
  227.                                              OR new_msg_action^.action_type;
  228.                 GOTO iterate;
  229.               END;
  230.  
  231.             new_msg_action^.action_type := action_msg_hold
  232.                                              OR new_msg_action^.action_type;
  233.  
  234.             IF action_word = 'HOLD_OLD' THEN
  235.               new_msg_action^.action_type := action_msg_old
  236.                                              OR new_msg_action^.action_type;
  237.  
  238.             IF action_word = 'REJECT' THEN
  239.               new_msg_action^.action_type := action_msg_reject
  240.                                              OR new_msg_action^.action_type;
  241.  
  242.             GOTO iterate;
  243.  
  244.           END; (*----- End HOLD/REJECT --------------------------------------*)
  245.  
  246.         (*-------------------------------------------------------------------*)
  247.         (* DISTRIBUTE name search                                            *)
  248.         (*-------------------------------------------------------------------*)
  249.  
  250.         IF action_word = 'DISTRIBUTE' THEN
  251.           BEGIN;
  252.  
  253.             IF NOT execute_load THEN
  254.               GOTO iterate;
  255.  
  256.             build_format1_block;
  257.  
  258.             new_msg_action^.action_type := action_msg_distr
  259.                                            OR new_msg_action^.action_type;
  260.  
  261.             GOTO iterate;
  262.  
  263.           END; (*----- End DISTRIBUTE ---------------------------------------*)
  264.  
  265.         (*-------------------------------------------------------------------*)
  266.         (* NOCHANGE_ADR                                                      *)
  267.         (*-------------------------------------------------------------------*)
  268.  
  269.         IF invert_flag AND (action_word = 'CHANGE_ADR') THEN
  270.           BEGIN;
  271.  
  272.             IF NOT execute_load THEN
  273.               GOTO iterate;
  274.  
  275.             build_format0_block;
  276.  
  277.             new_msg_action^.action_type := action_msg_change
  278.                                            OR new_msg_action^.action_type;
  279.  
  280.             GOTO iterate;
  281.  
  282.           END; (*----- End NOCHANGE_ADR -------------------------------------*)
  283.  
  284.         (*-------------------------------------------------------------------*)
  285.         (* CHANGE_ADR                                                        *)
  286.         (*-------------------------------------------------------------------*)
  287.  
  288.         IF action_word = 'CHANGE_ADR' THEN
  289.           BEGIN;
  290.  
  291.             {$IFDEF DEBUG2}
  292.               WRITELN('Action change -- ', s1);
  293.               DELAY(1000);
  294.             {$ENDIF}
  295.  
  296.             IF NOT execute_load THEN
  297.               GOTO iterate;
  298.  
  299.             (*---------------------------------------------------------------*)
  300.             (* Throw away the verb                                           *)
  301.             (*---------------------------------------------------------------*)
  302.  
  303.             s1 := subword(@s1, 2, 0);
  304.  
  305.             (*---------------------------------------------------------------*)
  306.             (* Find the line break and validate                              *)
  307.             (*---------------------------------------------------------------*)
  308.  
  309.             i := POS(' => ', s1);
  310.  
  311.             {$IFDEF DEBUG4}
  312.               WRITELN('=> look -- ', i, ' -- ', s1);
  313.               DELAY(1000);
  314.             {$ENDIF}
  315.  
  316.             IF i = 0 THEN
  317.               BEGIN;
  318.                 send_tnc_data_str('No => in action file -- ' + s1 + cr);
  319.                 GOTO ITERATE;
  320.               END;
  321.  
  322.             IF i = 1 THEN
  323.               BEGIN;
  324.                 send_tnc_data_str('No search in action file -- ' + s1 + cr);
  325.                 GOTO ITERATE;
  326.               END;
  327.  
  328.             (*---------------------------------------------------------------*)
  329.             (* Break the incoming line into two parts -- The search and      *)
  330.             (* the change to.                                                *)
  331.             (*---------------------------------------------------------------*)
  332.  
  333.             s2 := COPY(s1, i+4, 255);
  334.             s1 := COPY(s1, 1,   i-1);
  335.             strip_var(s1, 'B');
  336.             strip_var(s2, 'B');
  337.  
  338.             {$IFDEF DEBUG4}
  339.               WRITELN('=> split1 -- ', s1);
  340.               WRITELN('=> split2 -- ', s2);
  341.               DELAY(1000);
  342.             {$ENDIF}
  343.  
  344.             (*---------------------------------------------------------------*)
  345.             (* More validation on line break                                 *)
  346.             (*---------------------------------------------------------------*)
  347.  
  348.             IF s2 = '' THEN
  349.               BEGIN;
  350.                 send_tnc_data_str('No to address in action file -- ' + s1 + cr);
  351.                 GOTO ITERATE;
  352.               END;
  353.  
  354.             IF s1 = '' THEN
  355.               BEGIN;
  356.                 send_tnc_data_str('No search in action file -- ' + s1 + cr);
  357.                 GOTO ITERATE;
  358.               END;
  359.  
  360.             (*---------------------------------------------------------------*)
  361.             (* Test the search string                                        *)
  362.             (*---------------------------------------------------------------*)
  363.  
  364.             test_search;
  365.             IF active_tcb^.error_sw THEN
  366.               GOTO iterate;
  367.  
  368.             (*---------------------------------------------------------------*)
  369.             (* Reset any left over address                                   *)
  370.             (*---------------------------------------------------------------*)
  371.  
  372.             WITH active_tcb^.curr_msg.msg_i_mb DO
  373.               BEGIN;
  374.                 msg_to    := '';
  375.                 msg_to_at := '';
  376.                 msg_to_h  := '';
  377.               END;
  378.  
  379.             (*---------------------------------------------------------------*)
  380.             (* Break up the address                                          *)
  381.             (*---------------------------------------------------------------*)
  382.  
  383.             WITH active_tcb^.curr_msg.msg_i_mb DO
  384.             send_msg_to_process(s2);
  385.             IF active_tcb^.error_sw THEN
  386.               BEGIN;
  387.                 send_tnc_data_str('Bad address in action file -- ' + s2 + cr);
  388.                 GOTO ITERATE;
  389.               END;
  390.  
  391.             {$IFDEF DEBUG4}
  392.               WITH active_tcb^.curr_msg.msg_i_mb DO
  393.                 BEGIN;
  394.                   WRITELN('TO  -- ', msg_to);
  395.                   WRITELN('TO@ -- ', msg_to_at);
  396.                   WRITELN('TO. -- ', msg_to_h);
  397.                   DELAY(1000);
  398.                 END;
  399.             {$ENDIF}
  400.  
  401.             (*---------------------------------------------------------------*)
  402.             (* Build the to address string.  This is three strings butted    *)
  403.             (* against each other                                            *)
  404.             (*---------------------------------------------------------------*)
  405.  
  406.             WITH active_tcb^.curr_msg.msg_i_mb DO
  407.               BEGIN;
  408.  
  409.                 s2 := msg_to;
  410.  
  411.                 {$IFDEF DEBUG4}
  412.                   WRITELN('Cto  -- ', 1, ' -- ', s2);
  413.                 {$ENDIF}
  414.  
  415.                 i       := LENGTH(s2) + 1;
  416.                 str_ptr := ADDR(s2[i]);
  417.  
  418.                 IF msg_to_at = 'NONE' THEN
  419.                   str_ptr^ := ''
  420.                 ELSE
  421.                   str_ptr^ := msg_to_at;
  422.  
  423.                 {$IFDEF DEBUG4}
  424.                   WRITELN('Cto@ -- ', i, ' -- ', str_ptr^);
  425.                 {$ENDIF}
  426.  
  427.                 i       := i + LENGTH(str_ptr^) + 1;
  428.                 str_ptr := ADDR(s2[i]);
  429.  
  430.                 IF msg_to_h = 'NONE' THEN
  431.                   str_ptr^ := ''
  432.                 ELSE
  433.                   str_ptr^ := msg_to_h;
  434.  
  435.                 {$IFDEF DEBUG4}
  436.                   WRITELN('Cto. -- ', i, ' -- ', str_ptr^);
  437.                 {$ENDIF}
  438.  
  439.                 INC(i, LENGTH(str_ptr^) + 1);
  440.  
  441.               END;
  442.  
  443.             (*---------------------------------------------------------------*)
  444.             (* Build a new action block                                      *)
  445.             (*---------------------------------------------------------------*)
  446.  
  447.             j := action_msg_overhead + 1 + LENGTH(s1) + i;
  448.             GETMEM(new_msg_action, j);
  449.             FILLCHAR(new_msg_action^, j, #0);
  450.  
  451.             {$IFDEF DEBUG3}
  452.               trace_data('ACC', j, new_msg_action, s1);
  453.             {$ENDIF}
  454.  
  455.             new_msg_action^.next_action := NIL;
  456.             new_msg_action^.action_type := action_msg_change;
  457.  
  458.             new_msg_action^.action_info := s1;
  459.  
  460.             str_ptr := ADDR(new_msg_action^.action_info[LENGTH(s1) + 1]);
  461.             MOVE(s2, str_ptr^, i);
  462.  
  463.             (*---------------------------------------------------------------*)
  464.             (* Copy over the search info                                     *)
  465.             (*---------------------------------------------------------------*)
  466.  
  467.             copy_search_blocks;
  468.  
  469.             (*---------------------------------------------------------------*)
  470.             (* Chain the block on the end of the list                        *)
  471.             (*---------------------------------------------------------------*)
  472.  
  473.             IF last_msg_action = NIL THEN
  474.               first_msg_action := new_msg_action
  475.             ELSE
  476.               last_msg_action^.next_action := new_msg_action;
  477.  
  478.             last_msg_action := new_msg_action;
  479.  
  480.             (*---------------------------------------------------------------*)
  481.             (* Done                                                          *)
  482.             (*---------------------------------------------------------------*)
  483.  
  484.             {$IFDEF DEBUG2}
  485.               WRITELN('Action change loaded');
  486.               WRITELN(new_msg_action^.action_info);
  487.               i := LENGTH(new_msg_action^.action_info) + 1;
  488.               str_ptr := ADDR(new_msg_action^.action_info[i]);
  489.               WRITELN(LENGTH(str_ptr^), '=',str_ptr^);
  490.               INC(i, LENGTH(str_ptr^) + 1);
  491.               str_ptr := ADDR(new_msg_action^.action_info[i]);
  492.               WRITELN(LENGTH(str_ptr^), '=',str_ptr^);
  493.               INC(i, LENGTH(str_ptr^) + 1);
  494.               str_ptr := ADDR(new_msg_action^.action_info[i]);
  495.               WRITELN(LENGTH(str_ptr^), '=',str_ptr^);
  496.               DELAY(1000);
  497.             {$ENDIF}
  498.  
  499.             GOTO iterate;
  500.  
  501.           END; (*----- End CHANGE_ADR ---------------------------------------*)
  502.  
  503.         (*-------------------------------------------------------------------*)
  504.         (* MAKE_FILE                                                         *)
  505.         (*-------------------------------------------------------------------*)
  506.  
  507.         IF (action_word = 'MAKE_FILE')
  508.                               OR (action_word = 'MAKE_FILE_REPLACE')
  509.                               OR (action_word = 'MAKE_FILE_APPEND')  THEN
  510.           BEGIN;
  511.  
  512.             IF NOT execute_make THEN
  513.               GOTO iterate;
  514.  
  515.             {$IFDEF DEBUG2}
  516.               WRITELN('Action makefile -- ', s1);
  517.               DELAY(1000);
  518.             {$ENDIF}
  519.  
  520.             {$IFDEF DEBUG5}
  521.               WRITELN('Action makefile 1 -- ', s1);
  522.               DELAY(1000);
  523.             {$ENDIF}
  524.  
  525.             options_str := get_option_string(s1);
  526.  
  527.             {$IFDEF DEBUG5}
  528.               WRITELN('Action makefile 2 -- ', s1);
  529.               DELAY(1000);
  530.             {$ENDIF}
  531.  
  532.             validate_format1_statement;
  533.  
  534.             IF NOT active_tcb^.error_sw THEN
  535.               do_make_file;
  536.  
  537.             GOTO iterate;
  538.  
  539.           END; (*----- End MAKE_FILE ----------------------------------------*)
  540.  
  541.         (*-------------------------------------------------------------------*)
  542.         (* CLEAN_MSGS                                                        *)
  543.         (*-------------------------------------------------------------------*)
  544.  
  545.         IF action_word = 'CLEAN_MSGS' THEN
  546.           BEGIN;
  547.  
  548.             IF NOT execute_clean THEN
  549.               GOTO iterate;
  550.  
  551.             {$IFDEF DEBUG2}
  552.               WRITELN('Action makefile -- ', s1);
  553.               DELAY(1000);
  554.             {$ENDIF}
  555.  
  556.             validate_format1_statement;
  557.  
  558.             IF NOT active_tcb^.error_sw THEN
  559.               do_clean;
  560.  
  561.             GOTO iterate;
  562.  
  563.           END; (*----- End CLEAN_MSGS ---------------------------------------*)
  564.  
  565.         (*-------------------------------------------------------------------*)
  566.         (* Error                                                             *)
  567.         (*-------------------------------------------------------------------*)
  568.  
  569.         {$IFDEF DEBUG2}
  570.           WRITELN('Action bad word -- ', action_word);
  571.           DELAY(1000);
  572.         {$ENDIF}
  573.  
  574.         send_tnc_data_str('Bad word in action file -- ' + action_word + cr);
  575.  
  576.         (*-------------------------------------------------------------------*)
  577.         (* Loop end...                                                       *)
  578.         (*-------------------------------------------------------------------*)
  579.  
  580. iterate:
  581.  
  582.       END; (*----- End loop thru the file -----------------------------------*)
  583.  
  584.     (*-----------------------------------------------------------------------*)
  585.     (* Done.                                                                 *)
  586.     (*-----------------------------------------------------------------------*)
  587.  
  588.     CLOSE(action_file);
  589.  
  590.     (*-----------------------------------------------------------------------*)
  591.     (* Tell user done                                                        *)
  592.     (*-----------------------------------------------------------------------*)
  593.  
  594.     send_tnc_data_str('Action processing is complete' + cr);
  595.  
  596.   END;
  597.